home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / a_to_d / dwsock11 / dwinsock.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  22KB  |  904 lines
  1. {--------------------------------------------------------------
  2.     WinSock component for Borland Delphi.
  3.  
  4.     (C) 1995 by Ulf S÷derberg, ulfs@sysinno.se
  5.  
  6.   History
  7.       V1.0        950404        US            First release.
  8.  
  9.     Parts of this code was inspired by WINSOCK.PAS by Marc B. Manza.
  10. ---------------------------------------------------------------}
  11.  
  12. unit DWinSock;
  13.  
  14. interface
  15.  
  16. uses
  17.     SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  18.     Forms, Dialogs;
  19.  
  20. const
  21.     CM_SOCKMSG    = WM_USER+1;
  22.     MAXCONN            = 16;                                        { allow 16 clients for TServerSockets }
  23.  
  24. {$I winsock.inc }
  25. {$I winsock.if }
  26.  
  27. type
  28.     { DWinSock exception type }
  29.     ESockError = class(Exception);
  30.  
  31.   TSocket = class;                                        { Forward declaration }
  32.  
  33.     { Socket info codes }
  34.   TSockInfo = (siLookUp, siConnect, siListen, siRecv, siSend);
  35.  
  36.     {    Define notification events for socket controls. }
  37.     TSockInfoEvent = procedure (Sender : TObject; icode : TSockInfo) of object;
  38.     TClientEvent = TNotifyEvent;
  39.     TServerEvent = procedure (Sender : TObject; cid : integer) of object;
  40.  
  41.     {    TSockCtrl -- socket control component base class. }
  42.     TSockCtrl = class(TCustomControl)
  43.     private
  44.         {    Event handler references }
  45.         FOnInfo                    : TSockInfoEvent;
  46.  
  47.         { Design tim connection info }
  48.         FHost                        : string;
  49.     FAddress                : string;
  50.         FService                : string;
  51.     FPort                        : u_short;
  52.  
  53.     { Run time connection info }
  54.         FConn                        : TSocket;
  55.  
  56.         { Design time bitmap }
  57.     FPicture                : TBitmap;
  58.  
  59.         { Access functions }
  60.         procedure SetService(const s : string);
  61.         procedure SetHost(const n : string);
  62.         procedure SetAddress(const a : string);
  63.         procedure SetPort(p : u_short);
  64.  
  65.         { Returns the WinSock.DLL description }
  66.         function GetDescription : string;
  67.  
  68.     protected
  69.         { Protected declarations }
  70.         constructor Create(AOwner : TComponent); override;
  71.         destructor Destroy; override;
  72.         procedure Paint; override;
  73.         procedure OnSizeChanged(var Message : TWMSize); message WM_SIZE;
  74.  
  75.     public
  76.         { Public declarations }
  77.     procedure Info(icode : TSockInfo);
  78.         function LocalHost : string;
  79.         function Reverse(var a : string) : string;
  80.  
  81.         property Conn : TSocket read FConn;
  82.         property Description : string read GetDescription;
  83.  
  84.     published
  85.         { Published declarations }
  86.         property Address : string read FAddress write SetAddress;
  87.         property Port : u_short read FPort write SetPort;
  88.         property Service : string read FService write SetService;
  89.     property OnInfo : TSockInfoEvent read FOnInfo write FOnInfo;
  90.     end;
  91.  
  92.     { Definition of the TClientSocket component class }
  93.     TClientSocket = class(TSockCtrl)
  94.     private
  95.         {    Event handler references }
  96.         FOnConnect            : TClientEvent;
  97.         FOnDisconnect        : TClientEvent;
  98.         FOnRead                    : TClientEvent;
  99.         FOnWrite                : TClientEvent;
  100.  
  101.     protected
  102.         { Protected declarations }
  103.         procedure OnSockMsg(var Message : TMessage); message CM_SOCKMSG;
  104.  
  105.     public
  106.         { Public declarations }
  107.     procedure Open;
  108.         procedure Close;
  109.         function SendBuf(var buf; cnt : integer) : integer;
  110.         function RecvBuf(var buf; cnt : integer) : integer;
  111.  
  112.     function GetBytesSent : integer;
  113.         function RecvText : string;
  114.     procedure SendText(const s : string);
  115.  
  116.     property BytesSent : integer read GetBytesSent;
  117.     property Text : string read RecvText write SendText;
  118.  
  119.     published
  120.         { Published declarations }
  121.          constructor Create(AOwner : TComponent); override;
  122.         destructor Destroy; override;
  123.  
  124.         property Host : string read FHost write SetHost;
  125.  
  126.         property OnConnect : TClientEvent read FOnConnect write FOnConnect;
  127.         property OnDisconnect : TClientEvent read FOnDisconnect write FOnDisconnect;
  128.         property OnRead : TClientEvent read FOnRead write FOnRead;
  129.         property OnWrite : TClientEvent read FOnWrite write FOnWrite;
  130.     property OnInfo;
  131.     end;
  132.  
  133.     { Definition of the TServerSocket component class }
  134.     TServerSocket = class(TSockCtrl)
  135.     private
  136.         {    Event handler references }
  137.         FOnAccept                : TServerEvent;
  138.         FOnDisconnect        : TServerEvent;
  139.         FOnRead                    : TServerEvent;
  140.         FOnWrite                : TServerEvent;
  141.  
  142.         FConns                    : array [1..MAXCONN] of TSocket;
  143.  
  144.         function GetClient(cid : integer) : TSocket;
  145.  
  146.         function DoAccept : integer;
  147.  
  148.     protected
  149.         { Protected declarations }
  150.         procedure OnSockMsg(var Message : TMessage); message CM_SOCKMSG;
  151.  
  152.     public
  153.         { Public declarations }
  154.          constructor Create(AOwner : TComponent); override;
  155.         destructor Destroy; override;
  156.  
  157.     procedure Listen(nqlen : integer);
  158.         procedure Close;
  159.  
  160.         { Return client socket }
  161.         property Client[cid : integer] : TSocket read GetClient; default;
  162.  
  163.     published
  164.         { Published declarations }
  165.         property OnAccept : TServerEvent read FOnAccept write FOnAccept;
  166.         property OnDisconnect : TServerEvent read FOnDisconnect write FOnDisconnect;
  167.         property OnRead : TServerEvent read FOnRead write FOnRead;
  168.         property OnWrite : TServerEvent read FOnWrite write FOnWrite;
  169.         property OnInfo;
  170.     end;
  171.  
  172.     { TSocket -- socket api wrapper class. }
  173.     TSocket = class(TObject)
  174.     public
  175.         FParent                    : TSockCtrl;                        { socket owner }
  176.         FSocket                    : TSock;                                { socket id }
  177.         FAddr                        : sockaddr_in;                    { host address }
  178.         FConnected            : boolean;
  179.         FBytesSent            : integer;                            { bytes sent by last SendBuf call }
  180.  
  181.         constructor Create(AParent : TSockCtrl);
  182.         destructor Destroy;
  183.  
  184.     function LookupName(var name : string) : in_addr;
  185.     function LookupService(var service : string) : u_short;
  186.         procedure FillSocket(var name, addr, service : string; var port : u_short);
  187.  
  188.         function LocalAddress : string;
  189.         function LocalPort : integer;
  190.  
  191.         function RemoteHost : string;
  192.         function RemoteAddress : string;
  193.         function RemotePort : integer;
  194.  
  195.         procedure Listen(var name, addr, service : string; port : u_short; nqlen : integer);
  196.         procedure Open(var name, addr, service : string; port : u_short);
  197.         procedure Close;
  198.  
  199.         function SendBuf(var buf; cnt : integer) : integer;
  200.         function RecvBuf(var buf; cnt : integer) : integer;
  201.  
  202.         function RecvText : string;
  203.     procedure SendText(const s : string);
  204.  
  205.     property BytesSent : integer read FBytesSent;
  206.     property Text : string read RecvText write SendText;
  207.     end;
  208.  
  209. procedure Register;
  210.  
  211. implementation
  212.  
  213. {$R DWINSOCK}
  214.  
  215. var
  216.     ExitSave    : Pointer;
  217.     bStarted  : boolean;
  218.     nUsers    : integer;
  219.     nWSErr    : integer;
  220.     myVerReqd : word;
  221.   myWSAData : WSADATA;
  222.  
  223. {$I ERROR.INC}
  224.  
  225. { StartUp -- See if a Windows Socket DLL is present on the system. }
  226. procedure StartUp;
  227. begin
  228.     if bStarted then exit;
  229.   nUsers := 0;
  230.     myVerReqd:=$0101;
  231.     nWSErr := WSAStartup(myVerReqd,@myWSAData);
  232.     if nWSErr = 0 then
  233.         bStarted := true
  234.     else
  235.         raise ESockError.Create('Can''t startup WinSock');
  236. end;
  237.  
  238. { CleanUp -- Tell Windows Socket DLL we don't need its services any longer. }
  239. procedure CleanUp; far;
  240. begin
  241.     ExitProc := ExitSave;
  242.     if bStarted then
  243.     begin
  244.       nWSErr := WSACleanup;
  245.       bStarted := false;
  246.         end;
  247. end;
  248.  
  249. {--------------------------------------------------------------
  250.     TSocket implementation
  251.  --------------------------------------------------------------}
  252.  
  253. constructor TSocket.Create(AParent : TSockCtrl);
  254. begin
  255.     inherited Create;
  256.   FParent := AParent;
  257.     FSocket := INVALID_SOCKET;
  258.     FAddr.sin_family := PF_INET;
  259.     FAddr.sin_addr.s_addr := INADDR_ANY;
  260.   FAddr.sin_port := 0;
  261.     FConnected := false;
  262.     FBytesSent := 0;
  263. end;
  264.  
  265. destructor TSocket.Destroy;
  266. begin
  267.     if FConnected {or (FSocket <> INVALID_SOCKET)} then
  268.         CloseSocket(FSocket);
  269.     inherited Destroy;
  270. end;
  271.  
  272. { LocalAddress -- get local address }
  273. function TSocket.LocalAddress : string;
  274. var
  275.     sa : sockaddr_in;
  276.     nl : integer;
  277. begin
  278.     Result := '';
  279.     if FSocket = INVALID_SOCKET then exit;
  280.     if getsockname(FSocket, PSockaddr(@sa), @nl) = 0 then
  281.         Result := StrPas(inet_ntoa(sa.sin_addr));
  282. end;
  283.  
  284. { LocalPort -- get local port number }
  285. function TSocket.LocalPort : integer;
  286. var
  287.     sa : sockaddr_in;
  288.     nl : integer;
  289. begin
  290.     Result := 0;
  291.     if FSocket = INVALID_SOCKET then exit;
  292.     if getsockname(FSocket, PSockaddr(@sa), @nl) = 0 then
  293.         Result := ntohs(sa.sin_port);
  294. end;
  295.  
  296. { RemoteHost -- get name of connected remote host }
  297. function TSocket.Remote